home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0024_Disk volume labels in Delphi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-22  |  6.8 KB  |  217 lines
  1.  
  2. This document contains the source code for a unit that is useful for
  3. getting, setting, and deleting volume labels from a floppy or hard disk.
  4. The code for getting a volume label uses the Delphi FindFirst function,
  5. and the code for setting and deleting volume labels involves calling DOS
  6. interrupt 21h, functions 16h and 13h respectively.  Since function 16h
  7. isn't supported by Windows, it must be called through DPMI interrupt 31h,
  8. function 300h.
  9.  
  10. { *** BEGIN CODE FOR VOLLABEL UNIT *** }
  11.  
  12. unit VolLabel;
  13.  
  14. interface
  15.  
  16. uses Classes, SysUtils, WinProcs;
  17.  
  18. type
  19.   EInterruptError = class(Exception);
  20.   EDPMIError = class(EInterruptError);
  21.   Str11 = String[11];
  22.  
  23. procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
  24. function GetVolumeLabel(Drive: Char): Str11;
  25. procedure DeleteVolumeLabel(Drv: Char);
  26.  
  27. implementation
  28.  
  29. type
  30.   PRealModeRegs = ^TRealModeRegs;
  31.   TRealModeRegs = record
  32.     case Integer of
  33.       0: (
  34.         EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
  35.  
  36.         Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
  37.       1: (
  38.         DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
  39.         case Integer of
  40.           0: (
  41.             BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
  42.           1: (
  43.             BL, BH, BLH, BHH, DL, DH, DLH, DHH,
  44.             CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  45.   end;
  46.  
  47.   PExtendedFCB = ^TExtendedFCB;
  48.   TExtendedFCB = Record
  49.     ExtendedFCBflag : Byte;
  50.     Reserved1       : array[1..5] of Byte;
  51.  
  52.     Attr            : Byte;
  53.     DriveID         : Byte;
  54.     FileName        : array[1..8] of Char;
  55.     FileExt         : array[1..3] of Char;
  56.     CurrentBlockNum : Word;
  57.     RecordSize      : Word;
  58.     FileSize        : LongInt;
  59.     PackedDate      : Word;
  60.     PackedTime      : Word;
  61.     Reserved2       : array[1..8] of Byte;
  62.     CurrentRecNum   : Byte;
  63.     RandomRecNum    : LongInt;
  64.   end;
  65.  
  66. procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs);
  67. { procedure invokes int 31h function 0300h to simulate a real mode }
  68.  
  69. { interrupt  from protected mode. }
  70. var
  71.   ErrorFlag: Boolean;
  72. begin
  73.   asm
  74.     mov ErrorFlag, 0       { assume success }
  75.     mov ax, 0300h          { function 300h }
  76.     mov bl, Int            { real mode interrupt to execute }
  77.     mov bh, 0              { required }
  78.     mov cx, 0              { stack words to copy, assume zero }
  79.     les di, Regs           { es:di = Regs }
  80.     int 31h                { DPMI int 31h }
  81.     jnc @@End              { carry flag set on error }
  82.  
  83.   @@Error:
  84.     mov ErrorFlag, 1       { return false on error }
  85.   @@End:
  86.   end;
  87.   if ErrorFlag then
  88.     raise EDPMIError.Create('Failed to execute DPMI interrupt');
  89. end;
  90.  
  91. function DriveLetterToNumber(DriveLet: Char): Byte;
  92. { function converts a character drive letter into its numerical equiv. }
  93. begin
  94.   if DriveLet in ['a'..'z'] then
  95.     DriveLet := Chr(Ord(DriveLet) -32);
  96.   if not (DriveLet in ['A'..'Z']) then
  97.     raise EConvertError.CreateFmt('Cannot convert %s to drive number',
  98.  
  99.                                   [DriveLet]);
  100.   Result := Ord(DriveLet) - 64;
  101. end;
  102.  
  103. procedure PadVolumeLabel(var Name: Str11);
  104. { procedure pads Volume Label string with spaces }
  105. var
  106.   i: integer;
  107. begin
  108.   for i := Length(Name) + 1 to 11 do
  109.     Name := Name + ' ';
  110. end;
  111.  
  112. function GetVolumeLabel(Drive: Char): Str11;
  113. { function returns volume label of a disk }
  114. var
  115.   SR: TSearchRec;
  116.   DriveLetter: Char;
  117.   SearchString: String[7];
  118.   P: Byte;
  119. begin
  120.   SearchString := Drive + ':\*.*';
  121.  
  122.   { find vol label }
  123.   if FindFirst(SearchString, faVolumeID, SR) = 0 then begin
  124.     P := Pos('.', SR.Name);
  125.     if P > 0 then begin                      { if it has a dot... }
  126.       Result := '           ';               { pad spaces between name }
  127.       Move(SR.Name[1], Result[1], P - 1);    { and extension }
  128.       Move(SR.Name[P + 1], Result[9], 3);
  129.     end
  130.     else begin
  131.       Result := SR.Name;                     { otherwise, pad to end }
  132.       PadVolumeLabel(Result);
  133.  
  134.     end;
  135.   end
  136.   else
  137.     Result := '';
  138. end;
  139.  
  140. procedure DeleteVolumeLabel(Drv: Char);
  141. { procedure deletes volume label from given drive }
  142. var
  143.   CurName: Str11;
  144.   FCB: TExtendedFCB;
  145.   ErrorFlag: WordBool;
  146. begin
  147.   ErrorFlag := False;
  148.   CurName := GetVolumeLabel(Drv);        { get current volume label }
  149.   FillChar(FCB, SizeOf(FCB), 0);         { initialize FCB with zeros }
  150.   with FCB do begin
  151.     ExtendedFCBflag := $FF;              { always }
  152.     Attr := faVolumeID;                  { Volume ID attribute }
  153.  
  154.     DriveID := DriveLetterToNumber(Drv); { Drive number }
  155.     Move(CurName[1], FileName, 8);       { must enter volume label }
  156.     Move(CurName[9], FileExt, 3);
  157.   end;
  158.   asm
  159.     push ds                              { preserve ds }
  160.     mov ax, ss                           { put seg of FCB (ss) in ds }
  161.     mov ds, ax
  162.     lea dx, FCB                          { put offset of FCB in dx }
  163.     mov ax, 1300h                        { function 13h }
  164.     Call DOS3Call                        { invoke int 21h }
  165.  
  166.     pop ds                               { restore ds }
  167.     cmp al, 00h                          { check for success }
  168.     je @@End
  169.   @@Error:                               { set flag on error }
  170.     mov ErrorFlag, 1
  171.   @@End:
  172.   end;
  173.   if ErrorFlag then
  174.     raise EInterruptError.Create('Failed to delete volume name');
  175. end;
  176.  
  177. procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
  178. { procedure sets volume label of a disk.  Note that this procedure }
  179. { deletes the current label before setting the new one.  This is }
  180.  
  181. { required for the set function to work. }
  182. var
  183.   Regs: TRealModeRegs;
  184.   FCB: PExtendedFCB;
  185.   Buf: Longint;
  186. begin
  187.   PadVolumeLabel(NewLabel);
  188.   if GetVolumeLabel(Drive) <> '' then           { if has label... }
  189.     DeleteVolumeLabel(Drive);                   { delete label }
  190.   Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB));  { allocate real buffer }
  191.   FCB := Ptr(LoWord(Buf), 0);
  192.   FillChar(FCB^, SizeOf(FCB), 0);               { init FCB with zeros }
  193.   with FCB^ do begin
  194.  
  195.     ExtendedFCBflag := $FF;                     { required }
  196.     Attr := faVolumeID;                         { Volume ID attribute }
  197.     DriveID := DriveLetterToNumber(Drive);      { Drive number }
  198.     Move(NewLabel[1], FileName, 8);             { set new label }
  199.     Move(NewLabel[9], FileExt, 3);
  200.   end;
  201.   FillChar(Regs, SizeOf(Regs), 0);
  202.   with Regs do begin                            { SEGMENT of FCB }
  203.     ds := HiWord(Buf);                          { offset = zero }
  204.  
  205.     dx := 0;
  206.     ax := $1600;                                { function 16h }
  207.   end;
  208.   RealModeInt($21, Regs);                       { create file }
  209.   if (Regs.al <> 0) then                        { check for success }
  210.     raise EInterruptError.Create('Failed to create volume label');
  211. end;
  212.  
  213. end.
  214. { *** END CODE FOR VOLLABEL UNIT *** }
  215.  
  216.  
  217.